home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / win_m_p / pcpwhost.zip / HOST1C.COM / HOST.WAS < prev    next >
Text File  |  1992-09-01  |  38KB  |  1,125 lines
  1. ;Host Mode script v1.00c
  2.  
  3. ;***********************************************************************
  4. ;*                                                                     *   
  5. ;* HOST.WAS                                                            *
  6. ;* Copyright (C) 1992 Datastorm Technologies, Inc.                     *     
  7. ;* All rights reserverd.                                               * 
  8. ;*                                                                     * 
  9. ;* Purpose: Provides an interface for a remote user to send and        *
  10. ;*          receive files and electronic mail.                         *
  11. ;*                                                                     * 
  12. ;***********************************************************************
  13.  
  14. ;***********************************************************************
  15. ;*                                                                     *
  16. ;*  WARNING!!!!                                                        *
  17. ;*                                                                     *
  18. ;*  Do not modify this script file unless you have a good under-       *
  19. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  20. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  21. ;*                                                                     *
  22. ;***********************************************************************
  23.  
  24. ;***********************************************************************
  25. ;*                                                                     *
  26. ;*   MACRO DEFINITIONS                                                 *
  27. ;*                                                                     *
  28. ;***********************************************************************
  29. #define FALSE 0         ; Boolean variables
  30. #define TRUE  1         ;
  31.  
  32. #define NAMEMAX 30      ; maximum length for user name
  33. #define PSWDMAX 8       ; maximum user passwrd length
  34.  
  35. #define DISP 1          ; show characters for input
  36. #define MASK 0          ; hide characters for password input
  37.  
  38. #define MODEM_CON    0  ; Connection type is a MODEM
  39. #define DIRECT_CON   1  ; Connection type is direct cable / no MODEM
  40.  
  41. #define OPEN_SYSTEM   0 ; anyone can login
  42. #define CLOSED_SYSTEM 1 ; only users already in the HOST.USR can login
  43.  
  44. ; access_level levels for users
  45. #define NEWUSER      0  ; new - can't do file xfers
  46. #define REGUSER      1  ; normal-can do file xfers to upload/download areas
  47. #define SUPERUSER    2  ; super-can do file xfers to/from any drive/directory
  48.  
  49. #define FLD_SEP    59   ; Field separator is ACSII 59 (semi-colon)
  50.  
  51. #define HOSTUSRFILE  "HOST.USR" ; User data file
  52. #define HOSTLOGFILE  "HOST.LOG" ; Log of Host activity
  53. #define HOSTPRMFILE  "HOST.PRM" ; Parameter file
  54. #define HOSTHLPFILE  "HOST.HLP" ; Help file
  55. #define HOSTNWSFILE  "HOST.NWS" ; News file
  56. #define HOSTNUFILE   "HOST.NUF" ; New user file
  57. #define HOSTDNLDFILE "HOST.DNL" ; Download file list
  58.  
  59. ;Mail Defines
  60. #define HOSTMSGFILE  "HOST.MSG" ; Mail message file
  61. #define HOSTHDRFILE  "HOST.HDR" ; Mail header file
  62. #define PUBLIC     0    ; Mail message flags
  63. #define PRIVATE    1    ;
  64. #define NEWMAIL    2    ;
  65. #define DELETED    4    ;
  66.  
  67. ;***********************************************************************
  68. ;*                                                                     *
  69. ;*   GLOBAL VARIABLES                                                  *
  70. ;*                                                                     *
  71. ;***********************************************************************
  72. string welcome_msg, upload_path, dnload_path, ontime, offtime
  73. string record, name, first, last, passwrd, access_level, remarks, msg
  74. string logfile, parmfile, usrfile, newsfile, hlpfile, dnldfile
  75. string nufile, _time, _date, message, searchstr
  76. string hdrfile, msgfile, tempfile
  77. integer new_usr_level, connect_type, system_type, goodbye_option
  78. integer old_menu, new_menu, tempkey, status, msg_number
  79. integer action_status, dial_status, setup_status, meta_status
  80. integer local_logon, jump, sysop, already_saved
  81.  
  82. ;***********************************************************************
  83. ;*                                                                     *   
  84. ;* MAIN                                                                *
  85. ;*                                                                     *
  86. ;* This is the main program loop.                                      *
  87. ;*                                                                     *
  88. ;* Calls: SAVE_PRM, HOSTSETUP, HOSTLOG, WAITFORCALL,  GETUSER,         *
  89. ;*        DISPLAYFILE, CHECKMAIL, HOSTMENU                             *
  90. ;*                                                                     *
  91. ;* Modifies globals: action_status, meta_status, dial_status, name,    *
  92. ;*                   setup_status, jump, local_logon, new_menu, sysop, *
  93. ;*                   connect_type, newsfile, msg, access_level,        *
  94. ;*                   parmfile                                          *
  95. ;*                                                                     *
  96. ;***********************************************************************
  97. #include "SUBS.WAS"             ;host subroutine library
  98. #include "MAIL.WAS"             ;host mail routines
  99.  
  100. proc main
  101.  
  102.    set aspect spawn on                 ; allow spawning of scripts
  103.    fetch aspect scriptpath parmfile    ; build a path to the HOST.PRM
  104.    addfilename parmfile HOSTPRMFILE
  105.  
  106.    if not isfile parmfile              ; if the .PRM doesn't exist
  107.       execute "HOSTUTIL"               ; run HOSTUTIL.WAS
  108.    endif
  109.                                        ; get the status of the
  110.    action_status=$ACTIONBAR            ; programs modeless windows
  111.    meta_status=$METAKEYS
  112.    dial_status=$DIALDIR
  113.    setup_status=$SETUP
  114.    if action_status                    ; if action bar is on
  115.       actionbar off                    ;  turn it off
  116.     endif
  117.    if meta_status                      ; if metakeys are on
  118.       metakeys off                     ;  turn them off
  119.    endif
  120.  
  121.    if dial_status                      ; if dialing directory is on
  122.       dialdir off                      ;  turn it off
  123.    endif
  124.  
  125.    if setup_status                     ; if setup is on
  126.       setup off                        ;  turn it off
  127.    endif
  128.  
  129.    already_saved=0
  130.    
  131.    while 1
  132.       statmsg " "
  133.       setjmp 1 jump
  134.       HostSetup()            ; set system variables and open HOST.PRM
  135.       HostLog("Host mode online.", "")
  136.       pwtitlebar "PROCOMM PLUS for Windows - Host Mode"
  137.       WaitForCall()
  138.  
  139.       if local_logon
  140.          menuitem new_menu 3 "&Recycle!"
  141.          showmenu new_menu
  142.       else
  143.          enable menu 2
  144.       endif
  145.  
  146.       menuitem new_menu 4 "E&xit Host!"
  147.       showmenu new_menu
  148.  
  149.       if !sysop
  150.          GetUser()               ; Wait for someone to login
  151.          if success              ; If user logged on,
  152.             if (! $carrier) && (connect_type==MODEM_CON)
  153.                HostLog("Lost Carrier.", "")
  154.                loopwhile
  155.             endif
  156.             DisplayFile(newsfile, 23)
  157.             strfmt msg "Remote user %s online" name
  158.             pwtitlebar msg
  159.             if local_logon
  160.                HostLog(name, "logged in locally.")
  161.             else
  162.                HostLog(name, "logged in.")
  163.             endif
  164.             CheckMail()
  165.             HostMenu()
  166.             if not success
  167.                loopwhile
  168.             endif
  169.          endif
  170.       else
  171.          name = "SYSOP"
  172.          access_level="2"
  173.          time ontime
  174.          CheckMail()
  175.          HostMenu()
  176.       endif
  177.    endwhile
  178. endproc
  179.  
  180. ;***********************************************************************
  181. ;*                                                                     *   
  182. ;* HOSTMENU                                                            *
  183. ;*                                                                     *
  184. ;* This procedure is the main menu for the remote user.                *
  185. ;*                                                                     *
  186. ;*                                                                     * 
  187. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, DISPLAYFILE,        *
  188. ;*        FILELIST, UPLOAD, DOWNLOAD, CHAT, READMAIL, LEAVEMAIL,       *
  189. ;*        HOSTHANGUP, EXITHOST, HOSTGETYN, RESTORE_PRM, SWITCHDIR      *
  190. ;*                                                                     *
  191. ;* Modifies globals: access_level, connect_type, dnldfile, local_logon,*
  192. ;*                   hlpfile, offtime, ontime, goodbye_option, name,   *
  193. ;*                   action_status, meta_status,  dial_status,         *
  194. ;*                   setup_status                                      *
  195. ;*                                                                     *
  196. ;***********************************************************************
  197. proc HostMenu
  198. integer security
  199. string key, auto_ans_off
  200.    ;convert access_level level into an integer
  201.    atoi access_level security
  202.  
  203.    set txpace 0
  204.    while 1
  205.       HostPutS("`r`n")
  206.       HostPutS("`r`nF)iles      U)pload      D)ownload")
  207.       HostPutS("`r`nH)elp       T)ime        C)hat")
  208.       HostPutS("`r`nR)ead mail  L)eave mail  G)oodbye")
  209.  
  210.       if security==2
  211.          HostPutS("`r`n`r`nS)witch directory")
  212.          HostPutS("`r`nA)bort (SHUT DOWN host mode)")
  213.       endif
  214.  
  215.       HostPutS("`r`n`r`nYour Choice? ")
  216.  
  217.       if (! $carrier) && (connect_type==MODEM_CON)
  218.          HostLog("Lost Carrier", "")
  219.          SetFailure()
  220.          exitwhile
  221.       endif
  222.  
  223.       HostGetC(&key)
  224.       if failure
  225.          SetFailure()
  226.          exitwhile
  227.       endif
  228.  
  229.       HostPutS(key)
  230.  
  231.       switch key
  232. ;****************
  233. ;* F)iles       *
  234. ;****************
  235.          case "F"
  236.             if security!=2
  237.                fetch aspect scriptpath dnldfile
  238.                addfilename dnldfile HOSTDNLDFILE
  239.                DisplayFile(dnldfile, 23)
  240.                if not success
  241.                   FileList()
  242.                endif
  243.             else
  244.                FileList()
  245.             endif
  246.          endcase
  247. ;****************
  248. ;* U)pload      *
  249. ;****************
  250.          case "U"
  251.             if local_logon
  252.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  253.             else
  254.                if security==0
  255.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  256.                else
  257.                   Upload()
  258.                endif
  259.             endif
  260.          endcase
  261. ;****************
  262. ;* D)ownload    *
  263. ;****************
  264.          case "D"
  265.             if local_logon
  266.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  267.             else
  268.                if security==0
  269.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  270.                else
  271.                   Download()
  272.                endif
  273.             endif
  274.          endcase
  275. ;****************
  276. ;* H)elp        *
  277. ;****************
  278.          case "H"
  279.             fetch aspect scriptpath hlpfile
  280.             addfilename hlpfile HOSTHLPFILE
  281.             DisplayFile(hlpfile, 23)
  282.             if not success
  283.                HostPutS("`r`nHelp not available.`r`n")
  284.             endif
  285.          endcase
  286. ;****************
  287. ;* T)ime        *
  288. ;****************
  289.          case "T"
  290.             time offtime
  291.             HostPutS("`r`n`r`nOnline at: ")
  292.             HostPutS(ontime)
  293.             HostPutS("`r`nIt is now: ")
  294.             HostPuts(offtime)
  295.             HostPutS("`r`n`r`n")
  296.          endcase
  297. ;****************
  298. ;* C)hat        *
  299. ;****************
  300.          case "C"
  301.             if local_logon
  302.                HostPutS("`r`n`r`nYou can't chat during a local logon!`r`n`r`n")
  303.             else
  304.                Chat()
  305.             endif
  306.          endcase
  307. ;****************
  308. ;* R)ead Mail   *
  309. ;****************
  310.          case "R"
  311.             ReadMail()
  312.          endcase
  313. ;****************
  314. ;* L)eave Mail  *
  315. ;****************
  316.          case "L"
  317.             LeaveMail(0,"", "")
  318.             if not success
  319.                SetFailure()
  320.                return
  321.             endif
  322.          endcase
  323. ;****************
  324. ;* G)oodbye     *
  325. ;****************
  326.          case "G"                                ;Goodbye
  327.             time offtime
  328.             HostPutS("`r`n`r`nOnline at: ")
  329.             HostPutS(ontime)
  330.             HostPutS("`r`nIt is now: ")
  331.             HostPuts(offtime)
  332.             HostPutS("`r`n`r`n")
  333.                 
  334.             if connect_type==MODEM_CON
  335.                HostHangup()
  336.             endif
  337.             if goodbye_option==1
  338.                clear
  339.                ExitHost()
  340.             endif
  341.             HostLog(name, "logged out.")
  342.             exitwhile
  343.          endcase
  344. ;****************
  345. ; A)bort        *
  346. ;****************
  347.          case "A"
  348.             if security==2
  349.                HostPutS("`r`n`r`nAbort Host Mode (Y/N)?")
  350.                HostGetYN()
  351.                if success
  352.                   HostPutS("`r`nAborting ...`r`n")
  353.                   HostLog(name, "remote shutdown.")
  354.                   if connect_type==MODEM_CON
  355.                      HostPutS("`r`nHangup line (Y/N)?")
  356.                      HostGetYN()
  357.                      if success
  358.                         HostHangup()
  359.                         ; get modem auto answer string
  360.                         fetch modem autoansoff auto_ans_off   
  361.                         set txpace 50
  362.                         transmit auto_ans_off
  363.                         waitfor "OK" 5
  364.                         restore_prm()
  365.                      endif
  366.                   endif
  367.                   if action_status
  368.                      actionbar on
  369.                   endif
  370.                   if meta_status
  371.                      metakeys on
  372.                   endif
  373.                   if dial_status
  374.                      dialdir on
  375.                   endif
  376.                   if setup_status
  377.                      setup on
  378.                   endif
  379.                   clear
  380.                   statmsg " "
  381.                   pwtitlebar "PROCOMM PLUS for Windows"
  382.                   halt
  383.                endif
  384.             endif
  385.          endcase
  386. ;****************
  387. ; S)witch       *
  388. ;****************
  389.          case "S"
  390.             if security==2
  391.                SwitchDir()
  392.             endif
  393.          endcase
  394. ;***************
  395.       endswitch
  396.    endwhile
  397. endproc
  398.  
  399. ;***********************************************************************
  400. ;*                                                                     *   
  401. ;* FILELIST                                                            *
  402. ;*                                                                     *
  403. ;* This procedure displays a file directory for the user like the      *
  404. ;* DOS "DIR" command.                                                  *
  405. ;*                                                                     * 
  406. ;* Calls: HOSTPUTS, HOSTGETS, HOSTGETC                                 *
  407. ;*                                                                     *
  408. ;* Modifies globals: access_level, dnload_path,  msg                   *
  409. ;*                                                                     *
  410. ;***********************************************************************
  411. proc FileList
  412. string filespec, filepath, key, dirflag="<DIR>"
  413. integer security, again=0, linenum=1, maxlen=40
  414.     
  415.    atoi access_level security
  416.  
  417.    HostPutS("`r`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> ")
  418.    HostGetS(&filespec, maxlen, DISP)
  419.  
  420.    strcmp filespec ""
  421.    if success
  422.       filespec="*.*"
  423.    endif
  424.  
  425.    if security!=2
  426.       strcpy filepath dnload_path
  427.       addfilename filepath filespec
  428.    else
  429.       getdir 0 filepath
  430.       strfind filespec "\"
  431.       if not found
  432.          addfilename filepath filespec
  433.       else
  434.          strcpy filepath filespec
  435.       endif
  436.    endif
  437.  
  438.    findfirst filepath "D"
  439.    if found
  440.       strfind $FATTR "D"
  441.       if found
  442.          strfmt msg "`r`n`r`n %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  443.       else
  444.          strfmt msg "`r`n`r`n %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  445.       endif
  446.       HostPutS(msg)
  447.       linenum++
  448.       again=1
  449.    else
  450.       HostPutS("`r`n`r`nNo files found.`r`n")
  451.    endif
  452.    while again
  453.       if linenum==23
  454.          linenum=1
  455.          HostPutS("-MORE-")
  456.          HostGetC(&key)
  457.          HostPutS("`b`b`b`b`b`b")
  458.          strupr key
  459.          strcmp key "N"
  460.          if success
  461.             exitwhile
  462.          endif
  463.       endif
  464.  
  465.       findnext
  466.       if found
  467.          strfind $FATTR "D"
  468.          if found
  469.             strfmt msg " %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  470.          else
  471.             strfmt msg " %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  472.          endif
  473.          HostPutS(msg)
  474.          linenum++
  475.       else
  476.          HostPutS("`r`n-End of list.-`r`n")
  477.          exitwhile
  478.       endif
  479.    endwhile
  480. endproc
  481.  
  482. ;***********************************************************************
  483. ;*                                                                     *   
  484. ;* UPLOAD                                                              *
  485. ;*                                                                     *
  486. ;* This procedure provides a menu for the remote user to send files    *
  487. ;* to the host system.                                                 *
  488. ;*                                                                     * 
  489. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  490. ;*        ISWILDCARD, TXWAIT                                           *
  491. ;*                                                                     *
  492. ;* Modifies globals: connect_type, status, msg, name                   *
  493. ;*                                                                     *
  494. ;***********************************************************************
  495. proc upload
  496. string filename, choice
  497. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  498. integer calledfrom = 0
  499.  
  500.    while 1
  501.       HostPutS("`r`n")
  502.       HostPutS("`r`nK) Kermit      X) Xmodem")
  503.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  504.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  505.       HostPutS("`r`nZ) Zmodem")
  506.       HostPutS("`r`n")
  507.       HostPutS("`r`nYour choice? ")
  508.  
  509.       if (! $carrier) && (connect_type==MODEM_CON)
  510.          HostLog("Lost Carrier", "")
  511.          SetFailure()
  512.          exitwhile
  513.       endif
  514.       HostGetC(&choice)
  515.       if failure
  516.          exitwhile
  517.       endif
  518.       HostPutS(choice)
  519.  
  520.       switch choice
  521. ;****************
  522. ;* K)ermit      *
  523. ;****************
  524.          case "K"
  525.             GetFname(&filename, calledfrom)
  526.             if failure
  527.                exitwhile
  528.             endif
  529.             HostPutS(xferbegin)
  530.             txwait()
  531.             getfile kermit
  532.          endcase
  533. ;****************
  534. ;* X)modem      *
  535. ;****************
  536.          case "X"
  537.             GetFname(&filename, calledfrom)
  538.             if failure
  539.                exitwhile
  540.             endif
  541.             IsWildcard(&filename)
  542.             if failure
  543.                exitwhile
  544.             endif
  545.             HostPutS(xferbegin)
  546.             txwait()
  547.             getfile xmodem filename
  548.          endcase
  549. ;****************
  550. ;* Z)modem      *
  551. ;****************
  552.          case "Z"
  553.             GetFname(&filename, calledfrom)
  554.             if failure
  555.                exitwhile
  556.             endif
  557.             HostPutS(xferbegin)
  558.             txwait()
  559.             getfile zmodem
  560.          endcase
  561. ;****************
  562. ;* Y)modem      *
  563. ;****************
  564.          case "Y"
  565.             GetFname(&filename, calledfrom)
  566.             if failure
  567.                exitwhile
  568.             endif
  569.             HostPutS(xferbegin)
  570.             txwait()
  571.             getfile ymodem
  572.          endcase
  573. ;****************
  574. ;* O) 1K Xmodem *
  575. ;****************
  576.          case "O"
  577.             GetFname(&filename, calledfrom)
  578.             if failure
  579.                exitwhile
  580.             endif
  581.             IsWildcard(&filename)
  582.             if failure
  583.                exitwhile
  584.             endif
  585.             HostPutS(xferbegin)
  586.             txwait()
  587.             getfile 1kxmodem filename
  588.          endcase
  589. ;****************
  590. ;* E) 1K XmodemG*
  591. ;****************
  592.          case "E"
  593.             GetFname(&filename, calledfrom)
  594.             if failure
  595.                exitwhile
  596.             endif
  597.             IsWildcard(&filename)
  598.             if failure
  599.                exitwhile
  600.             endif
  601.             HostPutS(xferbegin)
  602.             txwait()
  603.             getfile 1kxmodemg filename
  604.          endcase
  605. ;****************
  606. ;* Y)modem-G    *
  607. ;****************
  608.          case "G"
  609.             GetFname(&filename, calledfrom)
  610.             if failure
  611.                exitwhile
  612.             endif
  613.             HostPutS(xferbegin)
  614.             txwait()
  615.             getfile ymodemg
  616.          endcase
  617. ;****************
  618. ;* Default      *
  619. ;****************
  620.          default
  621.             exitwhile
  622.          endcase
  623.       endswitch
  624.  
  625.       pause 1
  626.  
  627.       status=$FILEXFER
  628.     
  629.       while status==1
  630.          ;loop here while xfer is going on
  631.          status=$FILEXFER
  632.       endwhile
  633.  
  634.       if status==2
  635.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  636.          strfmt msg "uploaded %s successfully." filename
  637.          HostLog(name, msg) ;log a sucessful upload
  638.       elseif status==3
  639.          ;log a failed upload
  640.          pause 2
  641.          rxflush
  642.          txflush
  643.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  644.          strfmt msg "failed to upload %s." filename
  645.          HostLog(name, msg) ;log a sucessful upload
  646.       endif
  647.       exitwhile
  648.    endwhile
  649. endproc
  650.  
  651. ;***********************************************************************
  652. ;*                                                                     *   
  653. ;* DOWNLOAD                                                            *
  654. ;*                                                                     *
  655. ;* This procedure provides a menu for the remote user to receive       *
  656. ;* files.                                                              *
  657. ;*                                                                     * 
  658. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  659. ;*        ISWILDCARD, TXWAIT                                           *
  660. ;*                                                                     *
  661. ;* Modifies globals: connect_type, status, msg, name                   *
  662. ;*                                                                     *
  663. ;***********************************************************************
  664. proc download
  665.  
  666. string filename, choice
  667. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  668. integer calledfrom = 1
  669.  
  670.    while 1
  671.       HostPutS("`r`n")
  672.       HostPutS("`r`nK) Kermit      X) Xmodem")
  673.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  674.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  675.       HostPutS("`r`nZ) Zmodem")
  676.       HostPutS("`r`n")
  677.       HostPutS("`r`nYour choice? ")
  678.  
  679.       if (! $carrier) && (connect_type==MODEM_CON)
  680.          HostLog("Lost Carrier", "")
  681.          SetFailure()
  682.          exitwhile
  683.       endif
  684.  
  685.       HostGetC(&choice)
  686.       if failure
  687.          exitwhile
  688.       endif
  689.  
  690.       HostPutS(choice)
  691.  
  692.       switch choice
  693. ;****************
  694. ;* K)ermit      *
  695. ;****************
  696.          case "K"
  697.             GetFname(&filename, calledfrom)
  698.             if failure
  699.                exitwhile
  700.             endif
  701.             HostPutS(xferbegin)
  702.             txwait()
  703.             sendfile kermit filename
  704.          endcase
  705. ;****************
  706. ;* X)modem      *
  707. ;****************
  708.          case "X"
  709.             GetFname(&filename, calledfrom)
  710.             if failure
  711.                exitwhile
  712.             endif
  713.             IsWildcard(&filename)
  714.             if failure
  715.                exitwhile
  716.             endif
  717.             HostPutS(xferbegin)
  718.             txwait()
  719.             sendfile xmodem filename
  720.          endcase
  721. ;****************
  722. ;* Z)modem      *
  723. ;****************
  724.          case "Z"
  725.             GetFname(&filename, calledfrom)
  726.             if failure
  727.                exitwhile
  728.             endif
  729.             HostPutS(xferbegin)
  730.             txwait()
  731.             sendfile zmodem filename
  732.          endcase
  733. ;****************
  734. ;* Y)modem      *
  735. ;****************
  736.          case "Y"
  737.             GetFname(&filename, calledfrom)
  738.             if failure
  739.                exitwhile
  740.             endif
  741.             HostPutS(xferbegin)
  742.             txwait()
  743.             sendfile ymodem filename
  744.          endcase
  745. ;****************
  746. ;* O) 1K Xmodem *
  747. ;****************
  748.          case "O"
  749.             GetFname(&filename, calledfrom)
  750.             if failure
  751.                exitwhile
  752.             endif
  753.             IsWildcard(&filename)
  754.             if failure
  755.                exitwhile
  756.             endif
  757.  
  758.             HostPutS(xferbegin)
  759.             txwait()
  760.             sendfile 1kxmodem filename
  761.          endcase
  762. ;****************
  763. ;* E) 1K XmodemG*
  764. ;****************
  765.          case "E"
  766.             GetFname(&filename, calledfrom)
  767.             if failure
  768.                exitwhile
  769.             endif
  770.             IsWildcard(&filename)
  771.             if failure
  772.                exitwhile
  773.             endif
  774.             HostPutS(xferbegin)
  775.             txwait()
  776.             sendfile 1kxmodemg filename
  777.          endcase
  778. ;****************
  779. ;* Y)modem-G    *
  780. ;****************
  781.          case "G"
  782.             GetFname(&filename, calledfrom)
  783.             if failure
  784.                exitwhile
  785.             endif
  786.             HostPutS(xferbegin)
  787.             txwait()
  788.             sendfile ymodemg filename
  789.          endcase
  790. ;****************
  791. ;* Default      *
  792. ;****************
  793.          default
  794.             exitwhile
  795.          endcase
  796.       endswitch
  797.  
  798.       pause 1
  799.  
  800.       status=$FILEXFER
  801.     
  802.       while status==1
  803.          ;loop here while xfer is going on
  804.          status=$FILEXFER
  805.       endwhile
  806.         
  807.       rxflush
  808.       txflush
  809.       pause 1
  810.         
  811.       if status==2
  812.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  813.          strfmt msg "downloaded %s successfully." filename
  814.          HostLog(name, msg) ;log a sucessful download
  815.       elseif status==3
  816.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  817.          strfmt msg "failed to download %s." filename
  818.          HostLog(name, msg) ;log a sucessful download
  819.       endif
  820.       exitwhile
  821.    endwhile
  822. endproc
  823.  
  824. ;***********************************************************************
  825. ;*                                                                     *   
  826. ;* GETFNAME                                                            *
  827. ;*                                                                     *
  828. ;* This procedure validates a filename for upload or download.         *
  829. ;*                                                                     *
  830. ;* Input:  string fname (filename to be validated)                     *
  831. ;*         integer calledfrom (upload or download menu)                *
  832. ;*                                                                     *
  833. ;* Return:  Success for vaild filename, Failure on invalid filename    *
  834. ;*                                                                     *
  835. ;*                                                                     *
  836. ;* Notes:  Keeps level 1 users from downloading any file they want     *
  837. ;*                                                                     *
  838. ;* Calls: HOSTPUTS, HOSTGETS, SETFAILURE, SETSUCCESS, HOSTGETYN        *                                                     *
  839. ;*                                                                     *
  840. ;* Modifies globals: dnload_path,  access_level, msg                   *
  841. ;*                                                                     *
  842. ;*                                                                     *
  843. ;***********************************************************************
  844. proc GetFname
  845. strparm fname
  846. intparm calledfrom
  847. string filepath
  848. integer security, length
  849.  
  850.  
  851.    if calledfrom==0              ; user is uploading
  852.       filepath=upload_path
  853.    else
  854.       filepath=dnload_path       ; user is downloading
  855.    endif
  856.  
  857.    atoi access_level security
  858.  
  859.    HostPutS("`r`n`r`nFile name? ")
  860.  
  861.    HostGetS(&fname, 50, DISP)    ; get the filename
  862.    if failure
  863.       SetFailure()
  864.       return
  865.    endif
  866.  
  867.    strcmp fname ""               ; make sure user didn't hit
  868.    if success                    ; ENTER for the filename
  869.       SetFailure()
  870.       return
  871.    endif
  872.  
  873.    strlen fname length
  874.    if length>12
  875.       HostPutS("`r`nFilename is too long!`r`n`r`n")
  876.       SetFailure()
  877.       return
  878.    endif
  879.  
  880.    strupr fname                  ; uppercase the filename
  881.    HostPutS("`r`n")
  882.    if security!=2
  883.       strfind fname ":"          ; don't let regular users upload to
  884.       if found                   ; another drive
  885.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  886.          HostPutS(msg)
  887.          SetFailure()
  888.          return
  889.       endif
  890.  
  891.       strfind fname "\"          ; don't let regular users upload to
  892.       if found                   ; another path
  893.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  894.          HostPutS(msg)
  895.          SetFailure()
  896.          return
  897.       endif
  898.  
  899.       set dnldpath filepath
  900.       addfilename filepath fname ; build a fullpath for the filename
  901.       fname=filepath
  902.    else
  903.       getdir 0 filepath             ; level 2 users will upload to
  904.       set dnldpath filepath
  905.       addfilename filepath fname    ; the current directory
  906.       fname=filepath
  907.    endif
  908.  
  909.    findfirst fname                  ; find the file to see if it exist
  910.    if not found
  911.       if calledfrom == 1            ; if user is downloading
  912.          HostPutS("`r`nFile not found!`r`n")
  913.          SetFailure()
  914.          return
  915.       else
  916.          SetSuccess()
  917.          return
  918.       endif
  919.    else
  920.       if calledfrom == 0           ; user is uploading
  921.          if security !=2
  922.             HostPutS("`r`nFile already exists!`r`n")
  923.             SetFailure()
  924.             return
  925.          else
  926.             HostputS("`r`nFile exists, overwrite? ")
  927.             HostGetYN()
  928.             if success
  929.                HostPutS("`r`n")
  930.                delfile fname
  931.                if not success
  932.                   HostPutS("`r`n`r`nCan't delete file!`r`n")
  933.                   SetFailure()
  934.                   return
  935.                endif
  936.                SetSuccess()
  937.                return
  938.             else
  939.                SetFailure()
  940.                return
  941.             endif
  942.             HostPutS("`r`n")
  943.             SetFailure()
  944.             return
  945.          endif
  946.       endif
  947.       SetSuccess()
  948.    endif
  949.    HostPutS("`r`n")
  950. endproc
  951.  
  952. ;***********************************************************************
  953. ;*                                                                     *   
  954. ;* ISWILDCARD                                                          *
  955. ;*                                                                     *
  956. ;* This procedure keeps users from specifying wildcard characters in   *
  957. ;* a filename for transfer protocols that do no support them.          *
  958. ;*                                                                     *
  959. ;* Input:  string fname (filename to validate)                         *
  960. ;*                                                                     *
  961. ;* Return:  Success for valid filename, Failure otherwise              *
  962. ;*                                                                     * 
  963. ;* Calls: HOSTPUTS, SETFAILURE, SETSUCCESS                             *
  964. ;*                                                                     *
  965. ;* Modifies globals: none                                              *
  966. ;*                                                                     *
  967. ;***********************************************************************
  968. proc IsWildcard
  969. strparm fname
  970. string error = "`r`nNo wildcards allowed!`r`n"
  971.  
  972.    strfind fname "*"
  973.    if found
  974.       HostPutS(error)
  975.       SetFailure()
  976.       return
  977.    endif
  978.  
  979.    strfind fname "?"
  980.    if found
  981.       HostPutS(error)
  982.       SetFailure()
  983.       return
  984.    endif
  985.  
  986.    SetSuccess()
  987. endproc
  988.  
  989. ;***********************************************************************
  990. ;*                                                                     *   
  991. ;* SWITCHDIR                                                           *
  992. ;*                                                                     *
  993. ;* This procedure allows a level 2 user to change the working          *
  994. ;* directory                                                           *
  995. ;*                                                                     * 
  996. ;* Calls: HOSTPUTS, HOSTGETS, ISWILDCARD, HOSTLOG                      *
  997. ;*                                                                     *
  998. ;* Modifies globals: msg, name                                         *
  999. ;*                                                                     *
  1000. ;***********************************************************************
  1001. proc SwitchDir
  1002. string filepath, newpath
  1003.  
  1004.    getdir 0 filepath
  1005.    strfmt msg "`r`nCurrent directory is %s`r`n" filepath
  1006.    HostPutS(msg)
  1007.    HostPutS("Change to what directory? ")
  1008.    HostGetS(&newpath, 50, DISP)
  1009.    if success
  1010.       IsWildcard(newpath)
  1011.       HostPuts("`r`n")
  1012.       chdir newpath
  1013.       strfmt msg "changed directory to %s." newpath
  1014.       HostLog(name, msg)
  1015.       getdir 0 newpath
  1016.       strfmt msg "`r`nCurrent directory is now %s`r`n" newpath
  1017.       HostPuts(msg)
  1018.    endif
  1019. endproc
  1020.  
  1021. ;***********************************************************************
  1022. ;*                                                                     *   
  1023. ;* HOSTLOG                                                             *
  1024. ;*                                                                     *
  1025. ;* This procedure puts an activity message into the HOST.LOG file.     *
  1026. ;*                                                                     * 
  1027. ;* Calls: HOSTMSGBOX                                                   *
  1028. ;*                                                                     *
  1029. ;* Modifies globals: logfile, msg                                      *
  1030. ;*                                                                     *
  1031. ;***********************************************************************
  1032. proc HostLog
  1033. strparm activity1
  1034. strparm activity2
  1035.  
  1036.    isfile logfile
  1037.    if not success                       ;if new file put header at top
  1038.       fopen 1 logfile CREATE TEXT
  1039.       if success
  1040.          fputs 1 "  DATE      TIME             ACTIVITY"
  1041.          fputs 1 "--------  ----------   --------------------------------"
  1042.          fclose 1
  1043.       else
  1044.          HostMsgBox("Can't create HOST.LOG file!")
  1045.          return
  1046.       endif
  1047.    endif
  1048.         
  1049.    fopen 1 logfile WRITE TEXT
  1050.    if not success
  1051.       HostMsgBox("Can't open HOST.LOG file!")
  1052.       return
  1053.    endif
  1054.    fseek 1 0 2
  1055.    strfmt msg "%s  %s   %s %s" $DATE $TIME activity1 activity2
  1056.    fputs 1 msg
  1057.    fclose 1
  1058. endproc
  1059.  
  1060. ;***********************************************************************
  1061. ;*                                                                     *   
  1062. ;* SAVE_PRM                                                            *
  1063. ;*                                                                     *
  1064. ;* This procedure save_prm renames PW.PRM to PW.PRX and saves the      *
  1065. ;* current setup.                                                      *
  1066. ;*                                                                     * 
  1067. ;* Calls: nothing                                                      *
  1068. ;* Called by: MAIN                                                     *
  1069. ;* Modifies globals: none                                              *
  1070. ;*                                                                     *
  1071. ;***********************************************************************
  1072. proc save_prm
  1073. string prmfile
  1074. string oldprm="PW.PRM"
  1075. string newprm="PRM.BAK"
  1076.  
  1077.    if already_saved
  1078.       return
  1079.    endif
  1080.    already_saved=1   
  1081.    prmfile=$PWTASKPATH
  1082.    addfilename prmfile oldprm
  1083.    oldprm=prmfile
  1084.  
  1085.    prmfile=$PWTASKPATH
  1086.    addfilename prmfile newprm
  1087.    newprm=prmfile
  1088.    copyfile oldprm newprm
  1089.    savesetup
  1090. endproc
  1091.  
  1092. ;***********************************************************************
  1093. ;*                                                                     *   
  1094. ;* RESTORE_PRM                                                         *
  1095. ;*                                                                     *
  1096. ;* This procedure restore_prm restores the setup from disk and         *
  1097. ;* renames the PW.PRX file back to PW.PRM.                             *
  1098. ;*                                                                     * 
  1099. ;* Calls: NONE                                                         *
  1100. ;* Called by: ExitHost                                                 *
  1101. ;* Modifies globals: none                                              *
  1102. ;*                                                                     *
  1103. ;***********************************************************************
  1104. proc restore_prm
  1105. string prmfile
  1106. string oldprm="PW.PRM"
  1107. string newprm="PRM.BAK"
  1108.  
  1109.    restsetup
  1110.    prmfile=$PWTASKPATH
  1111.    addfilename prmfile oldprm
  1112.    oldprm=prmfile
  1113.  
  1114.    prmfile=$PWTASKPATH
  1115.    addfilename prmfile newprm
  1116.  
  1117.    newprm=prmfile
  1118.    delfile oldprm
  1119.    copyfile newprm oldprm
  1120.    isfile newprm
  1121.    delfile newprm
  1122. endproc
  1123.  
  1124. ;**** End of HOST.WAS ****
  1125.